COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 weil.lsp[e85,jmc]	Lisp functions for finding integer points
C00006 ENDMK
C⊗;
;;; weil.lsp[e85,jmc]	Lisp functions for finding integer points

;;; rational number package

(setq base (setq ibase 10.))

(defun lowest (x) (let ((y (gcd (car x) (cdr x))))
		       (cons (quotient (car x) y) (quotient (cdr x) y))))

(defun rplus (x y) (lowest (cons (plus (times (car x) (cdr y))
				       (times (cdr x) (car y)))
				 (times (cdr x) (cdr y)))))

(defun rtimes (x y) (lowest (cons (times (car x) (car y))
				  (times (cdr x) (cdr y)))))

(defun rneg (x) (cons (minus (car x)) (cdr x)))

(defun rminus (x y) (rplus x (rneg y)))

(defun rrecip (x) (if (lessp (car x) 0)
		      (cons (minus (cdr x)) (minus (car x)))
		      (cons (cdr x) (car x))))

(defun rquotient (x y) (rtimes x (rrecip y)))

(defun rlessp (x y) (lessp (car (rminus x y)) 0))

(defun intpart (x) (cons (quotient (car x) (cdr x)) 1))

(defun closest1 (x) (if (rlessp x '(0 . 1))
			(rneg (closest1 (rneg x)))
			(let ((y (intpart x)))
			     (if (rlessp (rminus x y) '(1 . 2))
				 y
				 (rplus y '(1 . 1))))))

;;; functions on points in the rational plane
(defun closest (x)
       (list (closest1 (car x)) (closest1 (cadr x))))

(defun lamm (z0 z1)
       (let ((deltax (rminus (car z1) (car z0)))
	     (deltay (rminus (cadr z1) (cadr z0))))
	    (rneg (rtimes '(2 . 1)
			  (rquotient (rplus (rtimes (car z0) deltax)
					    (rtimes (cadr z0) deltay))
				     (rplus (rtimes deltax deltax)
					    (rtimes deltay deltay)))))))

(defun newpoint (z)
       (let ((z1 (closest z)))
	    (let ((l (lamm z z1)))
		 (vplus z (vtimes l (vminus z1 z))))))

(defun vplus (z1 z2) (list (rplus (car z1) (car z2))
			   (rplus (cadr z1) (cadr z2))))

(defun vtimes (r z) (list (rtimes r (car z)) (rtimes r (cadr z))))

(defun vminus (z1 z2) (list (rminus (car z1) (car z2))
			    (rminus (cadr z1) (cadr z2))))

;;; tests
(newpoint '((3 . 5) (4 . 5)))
(newpoint '((12 . 5) (16 . 5)))
(closest '((3 . 5) (4 . 5)))
(lamm '((1 . 1) (1 . 1)) '((3 . 5) (4 . 5)))
(newpoint '((24 . 13) (10 . 13)))